perm filename FLIP[901,BGB] blob
sn#129624 filedate 1974-11-12 generic text, type T, neo UTF8
00100 TITLE FLIP
00200 EXTERN NUMVAL,FIX1A,STATUS,TSERVO,L1,L2,L3,P1,P2,P3
00201 INTERNAL LOGIC,HISTO,SIEVE,HISTOV,CLIY1,CLIY2,CLIX,PACKBUF
00202 INTERNAL PACK,XMINW,AREA,YMIN,YMAX,YBLIT,XSHIFT,SUMY
00203 INTERNAL SUMSQY,SUMX,SUMSQX,PAC,STOPWAR,ASHV
00204 INTERNAL COLORS,BUFFER,TSINIT,LENS,SWS,ZIP,TV,TVADD,TVSUB,ADDC
00205 INTERNAL IMULC,GRAD,PAN,FOCUS,TILT,PPP,TTT,FFF
00206 INTERNAL DAC,ARM,JOINT
00210 OPDEF CALL[34B8]
00220 OPDEF JCALL[35B8]
00230 OPDEF SPCWAR[43B8]
00300
00400 A←1
00500 B←2
00600 C←3
00700 D←4
00800 E←5
00900 F←6
01000 I←4
01100 J←5
01200 K←6
01300 L←7
01400 P←14
01500
01600 ;PICTURE ACCUMULATORS
01700 PAC: 0
01800 BLOCK 4000
01900
02000 ;HISTOGRAM VECTORS
02100 HISTOV: 0
02200 BLOCK 100
02300
02400 ;VIDICON INPUT BUFFER
02500 BUFFER: 0
02600 BLOCK 1000
02700
02800 ;COLOR IMAGE ARITHMETIC AREA
02900 COLORS: 0
03000 BLOCK 11000
03100
00100 ;(LOGIC N A B) SIMILAIR TO LISP BOOLE
00200 LOGIC: MOVEM B,TEMP#
00300
00400 CALL 1,NUMVAL ;INITIALIZE LOGIC OP CODE
00500 ROT A,-7
00600 IOR A,[<SETZM A,PAC(J)>]
00700 MOVEM A,LOGIC2
00800
00900 MOVE A,TEMP ;INITIALIZE I FOR A PAC
01000 CALL 1,NUMVAL
01100 IMULI A,200
01200 MOVEM A,I
01300
01400 MOVE A,C ;INITIALIZE J FOR B PAC
01500 CALL 1,NUMVAL
01600 IMULI A,200
01700 MOVEM A,J
01800
01900 MOVEI C,177 ;LOOP INDEX
02000 MOVE A,PAC(I) ;LOOP
02100 LOGIC2: MOVEM A,PAC(J)
02200 AOS I
02300 AOS J
02400 SOJGE C,.-4
02500
02600 SETZ A,
02700 POPJ P, ;EXIT
00100 ;HISTOGRAMS FROM COLORS (HISTO N)
00200
00300 HISTO: CALL 1,NUMVAL
00400 MOVNS A,A
00410 ANDI A,777777
00500
00600 MOVEI B,77 ;CLEAR HISTOGRAM VECTORS
00700 SETZM HISTOV(B)
00800 SOJGE B,.-1
00900
01000 MOVEI J,10777
01100 MOVE B,COLORS(J) ;GET BYTES 3,2,1,0
01200 ROT B,@A
01300
01400 LDB C,[POINT 4,B,26] ;INCREMENT
01500 AOS HISTOV+60(C) ;COLOR 3
01600 LDB C,[POINT 4,B,17]
01700 AOS HISTOV+40(C) ;COLOR 2
01800 LDB C,[POINT 4,B,8]
01900 AOS HISTOV+40(C) ;COLOR 1
02000 ANDI B,17
02100 AOS HISTOV(B) ;COLOR 0
02200
02300 SOJGE J,.-12
02400
02500 SETZ A,
02600 POPJ P,
00200 ;SET PAC FOR COLORS BETWEEN MIN AND MAX
00300 ;(SIEVE PAC COLOR MIN MAX)
00400 ;A←1 ;VALUE OF COLOR BYTE
00500 ;B←2 ;BIT MASK
00600 ;C←3 ;BIT WORD FOR PAC
00700 ;I←4 ;PAC WORD COUNTER
00800 ;J←5 ;PAC BIT INDEX
00900 ;K←6 ;PAC WORD INDEX
01000 MAX←7
01100 MIN←10
01200 CBP←11 ;COLORS BYTE POINTER
01300
01400 SIEVE: MOVEM 6,TEM6#
01500 MOVEM 7,TEM7#
01600 MOVEM 10,TEM10#
01700 MOVEM 11,TEM11#
01800 MOVEM B,TEMP ;SAVE AC'S
01900
02000 CALL 1,NUMVAL
02100 IMULI A,200
02200 MOVEM A,K ;PAC WORD INDEX INITIALIZE K
02300
02400 MOVE A,TEMP
02500 CALL 1,NUMVAL
02600 IMULI A,11
02700 ROT A,-6
02800 IORI A,COLORS
02900 IOR A,[XWD 1100,0]
03000 MOVEM A,CBP ;INITIALIZE COLORS BYTE POINTER
03100
03200 MOVE A,3
03300 CALL 1,NUMVAL
03400 MOVE MIN,A
03500
03600 MOVE A,4
03700 CALL 1,NUMVAL
03800 MOVE MAX,A
03900
04000 MOVEI B,1 ;INITIALIZE MIN,MAX,AND B
04100
04200 MOVEI I,177
04300 SOOL: MOVEI J,43 ;START OF OUTER LOOP
04400 SETZM C
04600 SOIL: ROT B,-1 ;START OF INNER LOOP
04700 LDB A,CBP
04800
04900 CAMGE A,MIN
05000 JRST .+3 ;NOT IN RANGE
05100 CAMGE A,MAX
05200 TDO C,B ;IN RANGE SET A BIT
05300
05400 AOS CBP
05500 SOJGE J,SOIL
05600 MOVEM C,PAC(K) ;ENTER BITS INTO PAC
05700 AOS K
05800 SOJGE I,SOOL
05900 MOVE 6,TEM6
06000 MOVE 7,TEM7
06100 MOVE 10,TEM10
06200 MOVE 11,TEM11
06300 SETZ 1,
06400 POPJ 14,
00100 ;(CLIY1 PAC)
00200 ;CLEAR INTERIOR Y POINT OF PICTURE
00300 CLIY1: CALL 1,NUMVAL
00400 IMULI A,200 ;PAC POINTER
00500 MOVEI B,77 ;LOOP COUNTER
00600 SETZB D,E
00700
00800 MOVE C,PAC(A)
00900 TDZ C,D
01000 IOR D,C
01100 MOVEM C,PAC(A)
01200
01300 MOVE C,PAC+1(A)
01400 TDZ C,E
01500 IOR E,C
01600 MOVEM C,PAC+1(A)
01700
01800 ADDI A,2
01900 SOJGE B,.-11
02000 SETZ A,
02100 POPJ P,
02200
02300 ;(CLIY2 PAC)
02400 ;CLEAR INTERIOR Y POINTS
02500 CLIY2: CALL 1,NUMVAL
02600 AOS A
02700 IMULI A,200
02800 MOVEI B,77
02900 SETZB D,E
03000 SUBI A,2
03100 MOVE C,PAC(A)
03200 TDZ C,D
03300 IOR D,C
03400 MOVEM C,PAC(A)
03500
03600 MOVE C,PAC+1(A)
03700 TDZ C,E
03800 IOR E,C
03900 MOVEM C,PAC+1(A)
04000
04100 SOJGE B,.-11
04200 SETZ A,
04300 POPJ P,
00100 ;(PACKBUF N)
00200 ;PACK TV BUFFER FROM COLOR VECTOR N
00300 PACKBUF: CALL 1,NUMVAL
00400 IMULI A,11
00500 ROT A,-6
00600 IORI A,COLORS
00700 IOR A,[XWD 1100,0] ;COLORS BYTE POINTER
00800 MOVE B,[POINT 4,BUFFER]
00900 MOVEI C,10777
01000
01100 LDB D,A
01200 IDPB D,B
01300 AOS A
01400 SOJGE C,.-3
01500
01600 SETZ A,
01700 POPJ P,
01800
01900 ;(PACK PAC COLOR N)
02000 ;PACK PICTURE ACCUMULATOR INTO COLOR USING M
02100 PACK: MOVEM B,TEMP
02200 CALL 1,NUMVAL
02300 ASH A,7
02400 MOVEM A,D ;PAC POINTER
02500 MOVE A,TEMP
02600 CALL 1,NUMVAL
02700 IMULI A,11
02800 ROT A,-6
02900 IORI A,COLORS
03000 IOR A,[XWD 1100,0] ;COLORS BYTE POINTER
03100 EXCH A,C
03200 CALL 1,NUMVAL ;CHARACTER TO BE PACKED
03300 MOVEM TEMP
03400 MOVEI B,177
03500 MOVEI E,43
03600
03700 MOVE PAC(D)
03800 TLNE D,400000
03900 DPB A,C
04000 LSH 1
04100 AOS C
04200 SOJGE E,.-4
04300 SOJGE B,.-7
04400 MOVE TEMP
04500 SETZ A,
04600 POPJ P,
00100 ;(CLIX PAC)
00200 ;CLEAR INTERIOR X POINTS OF PICTURE
00300 CLIX: CALL 1,NUMVAL
00400 ASH A,7 ;PAC POINTER
00500 MOVEI B,77 ;LOOP COUNTER
00600
00700 CLIX0: MOVE C,PAC(A)
00800 JFFO C,.+2
00850 JRST CLIX1
00900 HRLZI E,400000
01000 MOVNM D,D
01100 ANDI D,777777
01150 LSH E,@D ;1ST WORD LEFT SIDE
01200
01300 SKIPE PAC+1(A)
01400 JRST CLIX2
01500 MOVNM C,D
01600 AND C,D
01700 IOR E,C
01750 MOVEM E,PAC(A) ;1ST WORD RIGHT SIDE
01800 JRST CLIX3
01900 CLIX1: MOVE C,PAC+1(A)
02000 JFFO C,.+2
02050 JRST CLIX3
02100 HRLZI E,400000
02200 MOVNM D,D
02300 ANDI D,777777
02350 LSH E,@D ;2ND WORD LEFT SIDE
02352 MOVNM C,D
02354 AND C,D
02356 IOR E,C
02400 MOVEM E,PAC+1(A)
02500 CLIX2: MOVEM E,PAC(A)
02502 MOVE C,PAC+1(A)
02600 MOVNM C,D
02700 AND C,D
02800 MOVEM C,PAC+1(A) ;2ND WORD RIGHT SIDE
02900 CLIX3: ADDI A,2
03000 SOJGE B,CLIX0
03100 SETZ A,
03200 POPJ P,
00100 ;(XMINW PAC)
00200 ;XMINIMUM AND WIDTH
00300 XMINW: CALL 1,NUMVAL
00400 ASH A,7 ;PAC POINTER
00500 MOVEI C,77 ;LOOP COUNTER
00600 SETZB B,D
00700 IOR B,PAC(A)
00800 IOR D,PAC+1(A)
00900 ADDI A,2
01000 SOJGE C,.-3
01100
01200 JFFO B,.+6
01300 JFFO D,.+3
01400 SETZ A,
01500 JCALL 1,FIX1A ;NOTHING RETURN
01600 ADDI E,44
01700 MOVE C,E
01800
01900 SETZ E, ;BIT COUNTER
02000 MOVN A,B
02100 TDZE B,A
02200 AOJA E,.-2
02300 MOVN A,D
02400 TDZE D,A
02500 AOJA E,.-2
02600 MOVE A,C
02700 ASH A,7
02800 IOR A,E
02900 JCALL 1,FIX1A
03000
03100 ;(AREA PAC)
03200 ;RETURNS A COUNT OF TH NUMBER OF POINTS IN A PICTURE
03300 AREA: CALL 1,NUMVAL
03400 ASH A,7 ;PAC POINTER
03500 MOVEI B,177 ;LOOP COUNTER
03600 SETZ C, ;BIT COUNTER
03700 MOVE D,PAC(A)
03800 MOVN E,D ;MASK
03900 TDZE D,E
04000 AOJA C,.-2
04100 AOS A
04200 SOJGE B,.-5
04300 MOVE A,C
04400 JCALL 1,FIX1A
00100 ;(YMIN PAC)
00200 ;RETURNS LEAST Y-COORDINATE OF A POINT
00300 YMAX: CALL 1,NUMVAL
00400 AOS A
00500 ASH A,7
00600 MOVEI B,177
00700
00800 SOS A
00900 SKIPN PAC(A)
01000 SOJGE B,.-2
01200 ASH A,-1
01300 JCALL 1,FIX1A
01400
01500 ;(YMAX PAC)
01600 ;RETRUN GREATEST Y-COORDINATE
01700 YMIN: CALL 1,NUMVAL
01800 ASH A,7
01900 MOVEI B,177
02000 SKIPE PAC(A)
02100 JRST .+3
02200 AOS A
02300 SOJGE B,.-3
02500 ASH A,-1
02600 JCALL 1,FIX1A
00100 ;(YBLIT PAC1 PAC2 DY)
00200 ;BLIT PICTURE ACCUMULATOR 1 INTO 2 DISPLACED BY DY
00300 ;PLACES UPWARDS IN VIDICON COORDINATES
00400
00500 YBLIT: MOVEM B,TEMP
00600 CALL 1,NUMVAL
00700 ASH A,7
00800 ADDI A,PAC
00900 MOVEM A,D ;PAC1 FROM
01000
01100 MOVE A,TEMP
01200 CALL 1,NUMVAL
01300 ASH A,7
01400 ADDI A,PAC
01500 MOVEM A,E ;PAC2 TO
01600
01700 MOVE A,C
01800 CALL 1,NUMVAL
01900 MOVNM A,A ;DY
02000
02100 SKIPE A
02200 JRST .+5
02300
02400 HRLM D,E ;NO DISPLACEMENT
02500 ADDI D,177
02600 BLT E,@D
02700 POPJ P,
02800
02900 SKIPL A
03000 JRST YBLIT2
03100
03150 MOVNM A,A
03200 SETZM @E ; PAC2, PAC2+1
03300 MOVE B,E ; PAC2+DY*2-1
03400 HRLM E,E
03500 AOJ E,
03600 ASH A,1
03700 ADD B,A
03800 SOJ B,
03900 BLT E,@B ;CLEAR
04000
04100 HRLM D,B ;PAC1, PAC2+DY*2
04200 AOJ B, ; PAC2+177
04300 HLRZM E,E
04400 ADDI E,177
04500 BLT B,@E
04600 SETZ A,
04700 POPJ P, ;MOVE
04800
04900 YBLIT2: ASH A,1 ;PAC1+DY*2 , PAC2
05000 ADD D,A ; PAC2+177-DY*2
05100 HRLM D,E
05200 HRRZM E,B
05300 ADDI B,177
05400 SUB B,A
05500 BLT E,@B ;MOVE
05600
05700 AOJ B, ;PAC2+200-DY*2, PAC2+201-DY*2
05800 SETZM @B ; PAC2+177
05900 HRLM B,B
06000 AOJ B,
06100 HRRZM E,E
06200 ADDI E,177
06300 BLT B,@E ;CLEAR
06400 SETZ A,
06500 POPJ P,
00100 ;(XSHIFT PAC DX)
00200 ;SHIFT PICTURE ACCUMULATOR DX PLACES TO THE RIGHT
00300 XSHIFT: MOVEM B,TEMP
00400 CALL 1,NUMVAL
00500 ASH A,7
00600 MOVEM A,I ;PAC POINTER
00700 MOVE A,TEMP
00800 CALL 1,NUMVAL
00900 MOVNM A,A
01000 HRRM A,XSH2 ;MODIFY ADDRESS PART
01100 MOVEI J,77 ;LOOP COUNTER
01200 XSH1: MOVE A,PAC(I)
01300 MOVE B,PAC+1(I)
01400 XSH2: LSHC A,0
01500 MOVEM A,PAC(I)
01600 MOVEM B,PAC+1(I)
01700 ADDI I,2
01800 SOJGE J,XSH1
01900 SETZ A,
02000 POPJ P,
00100 ;(SUMY PAC)(SUMSQY)
00200 SUMY: MOVEM TEMP
00300 MOVEM 6,TEM2#
00400 CALL 1,NUMVAL
00500 ASH A,7 ;PAC POINTER
00600 MOVEI B,77 ;LOOP COUNTER
00700 SETZB 6,0
00800
00900 SUMY1: SETZ C,
01000 MOVE D,PAC(A)
01100 MOVN E,D
01200 TDZE D,E
01300 AOJA C,.-2
01400 MOVE D,PAC+1(A)
01500 MOVN E,D
01600 TDZE D,E
01700 AOJA C,.-2
01800 IMUL C,B
01900 ADD C
02000 IMUL C,B
02100 ADD 6,C
02200 ADDI A,2
02300 SOJGE B,SUMY1
02400 MOVE A,0
02500 MOVE TEMP
02600 EXCH 6,TEM2
02700 JCALL 1,FIX1A
02800 SUMSQY: MOVE 1,TEM2
02900 JCALL 1,FIX1A
00100 XHIST:
00200 BLOCK 110
00300 ;(SUMX PAC)(SUMSQX)
00400 SUMX: MOVE TEMP
00500 CALL 1,NUMVAL
00600 ASH A,7
00700 SETZM XHIST
00800 MOVE B,[XWD XHIST,XHIST+1]
00900 BLT B,XHIST+107 ;CLEAR X HISTOGRAM
01000 MOVEI B,77 ;LOOP COUNTER
01100 SUMX1: SETZ E, ;X HISTOGRAM POINTER
01200 MOVE C,PAC(A)
01300 MOVE 0,PAC+1(A) ;PICKUP HORIZONTAL LINE
01400 SUMX2: JFFO C,.+2
01500 JRST SUMX3
01600 ADD E,D
01650 AOJ E,
01700 AOS XHIST(E)
01800 EXCH D,0
01900 LSHC C,1
02000 LSHC C,@0
02100 EXCH D,0
02200 JRST SUMX2
02300 SUMX3: JUMPE SUMX4
02400 ADDI E,44
02500 EXCH C,0
02600 JRST SUMX2
02700 SUMX4: ADDI A,2
02800 SOJGE B,SUMX1
03000 MOVEI A,107 ;XHIST POINTER
03100 SETZB B,C
03200
03300 MOVE D,XHIST(A) ;NUMBER OF POINTS AT
03400 JUMPE D,.+5
03500
03600 IMUL D,A ;VALUE X
03700 ADD B,D
03800 IMUL D,A ;SQUARED
03900 ADD C,D
04000
04100 SOJGE A,.-6
04200 MOVEM C,TEMP
04300 MOVE A,B
04400 JCALL 1,FIX1A
04500
04600 SUMSQX: MOVE A,TEMP
04700 JCALL 1,FIX1A
00100 ;GRADIENT
00200 ;RETURNS (DX↑2 + DY↑2)*2↑-4 IN COLOR 1
00300
00400 GRAD: MOVEI A,10666
00500 MOVE B,COLORS(A)
00600 ANDI B,777
00700
00800 MOVE D,COLORS+1(A)
00900 ANDI D,777
01000 SUB D,B ;DELTA X
01100
01200 MOVE C,COLORS+110(A)
01300 ANDI C,777
01400 SUB C,B ;DELTA Y
01500
01600 IMUL C,C
01700 IMUL D,D ;SQUARED
01800
01900 ADD C,D
02000 ASH C,-4
02100
02200 ANDI C,777
02300 ROT C,9
02400
02500 IOR C,B
02600 HRRM C,COLORS(A)
02700
02800 SOJGE A,GRAD+1
02900 SETZ A,
03000 POPJ P,
03100
00100 ;(TVADD N)
00200 ;CONVERT BUFFER TO GRAY SCALE AND ADD INTO COLOR N
00300
00400 TVADD: CALL 1,NUMVAL
00500 ANDI A,3
00600 MOVE A,GREY(A) ;SELECT NTH BYTE
00700 HRRM A,.+6
00800
00900 SETZB D,E
01000 MOVEI C,10 ;BYTE COUNTER
01100
01200 MOVE B,BUFFER(D)
01300 SETZ A,
01400
01500 ROTC A,4
01600 MOVE A,GREY(A) ;CONVERSION
01700 ADDM A,COLORS(E) ;ADDITION
01800
01900 AOJ E,
02000 SOJGE C,.-5
02100
02200 AOJ D, ;BUFFER POINTER
02300 CAIE D,1000
02400 JRST .-12
02500 SETZ A,
02600 POPJ P,
00100 ;COLOR BYTE POINTER MACRO
00200 DEFINE CBYTE (A)
00300 { CALL 1,NUMVAL
00400 IMULI 1,11
00500 ROT 1,-6
00600 IORI 1,COLORS
00700 IOR 1,[XWD 1100,0]
00800 MOVEM 1,A
00900 ⎇
00100 ;(TVSUB N)
00200 ;CONVERT BUFFER TO GRAY SCALE AND SUBTRACT FROM COLOR N
00300
00400 TVSUB: CBYTE(E)
00500 SETZ D,
00600 MOVEI C,10
00700 MOVE B,BUFFER(D)
00800 SETZ A,
00900 ROTC A,4
01000
01100 LDB F,E
01200 SUB F,GREY0(A)
01300 DPB F,E
01400
01500 AOJ E,
01600 SOJGE C,.-6
01700
01800 AOJ D,
01900 CAIE D,1000
02000 JRST .-13
02100 SETZ A,
02200 POPJ P,
00100 ;SCALAR MULTIPLICATION OF NTH COLOR VECTOR
00200 ;(IMULC V S)
00300
00400 IMULC: MOVEM B,C
00500 CBYTE (D)
00600 MOVE A,C
00700 CALL 1,NUMVAL
00800
00900 MOVEI C,10777
01000
01100 LDB B,D
01200 IMUL B,A
01300 DPB B,D
01400
01500 AOJ D,
01600
01700 SOJGE C,.-4
01800 SETZ A,
01900 POPJ P,
02000
02100
02200
02300 ;ADDITION OF TWO COLOR VECTORS
02400
02500 ADDC: MOVEM B,C
02600 CBYTE (D)
02700 MOVE A,C
02800 CBYTE (B)
02900 MOVEI A,10777
03000
03100 LDB C,D
03200 LDB E,B
03300
03400 ADD C,E
03500
03600 DPB C,D
03700
03800 AOJ D,
03900 AOJ E,
04000 SOJGE A,.-6
04100 SETZ A,
04200 POPJ P,
04300
04400 ;SHIFT COLOR VECTOR
04500 ;(ASHV V N)
04600 ASHV: MOVEM B,TEMP
04700 CBYTE (C)
04800 MOVE A,TEMP
04900 CALL 1,NUMVAL
05000 HRRM A,.+3
05100 MOVEI B,10777
05200 LDB A,C
05300 ASH A,0
05400 DPB A,C
05500 AOJ C,
05600 SOJGE B,.-4
05700 SETZ A,
05800 POPJ P,
00100 ;TV CAMERA SERVO INITIALIZAION
00200 TSINIT: MOVEI 1,11
00300 MOVE 1,STATUS
00400 SPCWAR 0,636367
00500 SPCWAR 1,TSERVO
00600 SETZ A,
00700 POPJ P,
00800
00900 ;READ SPACE WAR SWITCHES
01000 SWS: CALLI 1,400000
01100 ANDI 1,377
01200 JCALL 1,FIX1A
01300
01400 ;STOP SPACEWAR JOB
01500 STOPWAR: SPCWAR 0,636367
01600 SETZ A,
01700 POPJ P,
01800
01900 ;ADVANCE LENS TURRET
02000 LENS: MOVEI 1,14
02100 MOVEM 1,STATUS
02200 MOVE 1,STATUS
02300 TRNE 1,20
02400 HALT ;HUNG
02500 TRNN 1,1
02600 JRST .-4
02700 SETZ 1,
02800 POPJ P,
02900
03000 ;CLEAR COLORS
03100 ZIP: SETZM COLORS
03200 MOVE A,[XWD COLORS,COLORS+1]
03300 BLT A,COLORS+10777
03400 SETZ A,
03500 POPJ P,
00100 ;(TV X Y Z)INPUT FROM VIDICON INTO BUFFER
00200
00300 TV: MOVEM B,TEMP
00400 CALL 1,NUMVAL
00500 MOVEM A,D
00550 MOVE A,TEMP
00600 CALL 1,NUMVAL ;Y
00700 ROT A,9
00800 IOR A,D ;X
00900 ROT A,9
01000 IORI A,10 ;WIDTH
01100 ROT A,9
01200 MOVEM A,E2
01300
01400 MOVE A,C
01500 CALL 1,NUMVAL
01600 MOVEM A,E1
01700
01800 INIT 17,17
01900 SIXBIT/TV/
02000 0
02100 HALT ;INIT ERROR TV
02200
02300 INPUT 17,E0
02400 SETZ A,
02500 POPJ P,
02600
02700 E0: XWD -1000,BUFFER
02800 E1: 0
02900 E2: 0
03000 E3: 0
00100 FOCUS: CALL 1,NUMVAL
00200 MOVEM 1,L1
00300 SETZB 1,STATUS
00400 POPJ P,
00500
00600 PAN: CALL 1,NUMVAL
00700 MOVEM 1,L3
00800 SETZB 1,STATUS
00900 POPJ P,
01000
01100 TILT: CALL 1,NUMVAL
01200 MOVEM 1,L2
01300 SETZB 1,STATUS
01400 POPJ P,
01500
01600 FFF: MOVE A,P1
01700 JCALL 1,FIX1A
01800 PPP: MOVE A,P3
01900 JCALL 1,FIX1A
02000 TTT: MOVE A,P2
02100 JCALL 1,FIX1A
02200
02300
00100 ;GREY CODE
00200
00300 GREY: MOVE A,GREY0(A)
00350 MOVE A,GREY1(A)
00375 MOVE A,GREY2(A)
00387 MOVE A,GREY3(A)
00400
00500 GREY0: 12 ↔ 13 ↔ 11 ↔ 10
00600 15 ↔ 14 ↔ 16 ↔ 17
00700 5 ↔ 4 ↔ 6 ↔ 7
00800 2 ↔ 3 ↔ 1 ↔ 0
00900 GREY1: 12B26 ↔ 13B26 ↔ 11B26 ↔ 10B26
01000 15B26 ↔ 14B26 ↔ 16B26 ↔ 17B26
01100 5B26 ↔ 4B26 ↔ 6B26 ↔ 7B26
01200 2B26 ↔ 3B26 ↔ 1B26 ↔ 0
01300 GREY2: 12B17 ↔ 13B17 ↔ 11B17 ↔ 10B17
01400 15B17 ↔ 14B17 ↔ 16B17 ↔ 17B17
01500 5B17 ↔ 4B17 ↔ 6B17 ↔ 7B17
01600 2B17 ↔ 3B17 ↔ 1B17 ↔ 0
01700 GREY3: 12B8 ↔ 13B8 ↔ 11B8 ↔ 10B8
01800 15B8 ↔ 14B8 ↔ 16B8 ↔ 17B8
01900 5B8 ↔ 4B8 ↔ 6B8 ↔ 7B8
02000 2B8 ↔ 3B8 ↔ 1B8 ↔ 0
02100
02200
02300
02400
00100 ;(JOINT J X)
00200 ;MOVE JOINT J X INCREMENTS OR DECREMENTS
00300 JOINT: MOVEM B,C
00400 CALL 1,NUMVAL
00500 EXCH A,C
00600 CALL 1,NUMVAL
00700 ANDI C,7
00750 SOS C
00800 ADDM A,JOY(C)
00900 SETZ A,
01000 POPJ P,
01100 JOY: 0
01200 BLOCK 10
01300
01400 ;(ARM) START ARM SPACE WAR JOB
01500 ARM: SPCWAR 0,636367
01600 SPCWAR 1,DAC3
01700 SETZ A,
01800 POPJ P,
01900
02000 ;(DAC N Z) N=1 TO 7
02100 ;SET D TO A CONVERTER
02200 DAC: MOVEM B,C
02300 CALL 1,NUMVAL
02400 EXCH A,C
02500 CALL 1,NUMVAL
02600 ASH A,12
02700 ANDI C,7
02800 SOS C
02900 IOR A,C
03000 HRRM A,DAC3(C)
03100 SETZ A,
03200 POPJ P,
03300
03400 ;ARM SPACE WAR JOB
03500 DAC3: CONO 600,0 ;SET UP D TO A
03600 CONO 600,1
03700 CONO 600,2
03800 CONO 600,3
03900 CONO 600,4
04000 CONO 600,5
04100 CONO 600,6
04200
04300 MOVEI A,6 ;COUNT
04400 MOVEI B,20 ;BIT
04500 SETZ C, ;DATAO WORD TO BE
04600
04700 DAC4: SKIPN D,JOY(A)
04800 JRST DAC6
04900 IOR C,B ;NON-ZERO JOINT COUNT
05000 ROT B,1
05100 SKIPG D
05200 JRST DAC5
05300 ROT B,1 ;POSITIVE
05400 SOS JOY(A)
05500 JRST DAC6A
05600
05700 DAC5: IOR C,B ;NEGATIVE
05800 ROT B,1
05900 AOS JOY(A)
06000 JRST DAC6A
06100
06200 DAC6: ROT B,2 ;ZERO JOINT COUNT
06300 DAC6A: SOJGE A,DAC4
06400 MOVEM C,DAC8
06500 DATAO 420,DAC8
06600 HALT
06700 DAC8: 0
06800
06900 END